home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / bbs / pcsuni1.zip / HOHO302.ZIP / HOHAUS3.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1997-03-24  |  7KB  |  319 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Integer  INTEGER003
  22.     Integer  INTEGER004
  23.     Integer  INTEGER005
  24.     Integer  INTEGER006
  25.     String   STRING001
  26.     String   STRING002
  27.     String   TSTRING003(10)
  28.     String   STRING004
  29.     String   STRING005
  30.     String   STRING006
  31.     String   STRING007
  32.     String   STRING008
  33.     String   STRING009
  34.     String   STRING010
  35.  
  36. ;------------------------------------------------------------------------------
  37.  
  38.     DCloseAll
  39.     STRING009 = String(PcbNode())
  40.     If (PcbNode() == 0) STRING009 = "A"
  41.     STRING010 = GetEnv(STRING009 + "RECNO")
  42.     STRING010 = ToInteger(STRING010)
  43.     :LABEL001
  44.     DCloseAll
  45.     DOpen 0, PPEPath() + "HOHAUS.DBF", 0
  46.     DGo 0, STRING010
  47.     INTEGER001 = DRecNo(0)
  48.     DGet 0, "HANDLE", STRING005
  49.     DGet 0, "MAIL_NUM", STRING006
  50.     Cls
  51.     Newlines 6
  52.     PrintLn "@POS:20@@X10┌───────────────────────────────────@X19┐@X0F"
  53.     PrintLn "@POS:20@@X10│ @X1BR@X13ead your message file            @X19│@X0F"
  54.     PrintLn "@POS:20@@X10│ @X1BE@X13nter a message to another player @X19│@X0F"
  55.     PrintLn "@POS:20@@X10│ @X1BK@X13ill your message file            @X19│@X0F"
  56.     PrintLn "@POS:20@@X10│ @X1BM@X13ain Menu                         @X19│@X0F"
  57.     PrintLn "@POS:20@@X10│ @X1BG@X13raffiti wall reading             @X19│@X0F"
  58.     PrintLn "@POS:20@@X10│ @X1BW@X13rite on the graffiti wall        @X19│@X0F"
  59.     PrintLn "@POS:20@@X10└@X19───────────────────────────────────┘@X0F"
  60.     Newline
  61.     Print "@POS:20@  Your Choice ", Trim(Mixed(STRING005), " ")
  62.     InputStr " @X0A> _", STRING004, 11, 1, "REKMGW", 0 + 8
  63.     Select Case (STRING004)
  64.         Case "K"
  65.             If (Exist(PPEPath() + String(STRING006) + ".MSG")) Then
  66.                 Delete PPEPath() + String(STRING006) + ".MSG"
  67.                 Backup 80
  68.                 ClrEol
  69.                 PrintLn "@X8CMail file erased!@X0F"
  70.                 Print "                     "
  71.                 Wait
  72.                 Goto LABEL001
  73.             Endif
  74.             Goto LABEL001
  75.         Case "E"
  76.             Backup 80
  77.             ClrEol
  78.             InputStr "@X0CName of player to send mail to @X0E:@X0F _", STRING007, 11, 25, Mask_Ascii(), 0 + 8
  79.             If (STRING007 == "") Goto LABEL001
  80.             If (Upper(Trim(STRING007, " ")) == Upper(Trim(STRING005, " "))) Then
  81.                 Backup 80
  82.                 ClrEol
  83.                 PrintLn "@X0CSorry ", Mixed(Trim(STRING005, " ")), ", no need to send yourself mail!@X0F"
  84.                 Print "                     "
  85.                 Wait
  86.                 Goto LABEL001
  87.             Endif
  88.             DnCreate 0, PPEPath() + String(PcbNode()) + "-MH.NDX", "HANDLE"
  89.             DTop 0
  90.             DSeek 0, STRING007
  91.             If (DChkStat(0) > 0) Goto LABEL002
  92.             INTEGER002 = DRecNo(0)
  93.             DnCloseAll 0
  94.             Delete PPEPath() + String(PcbNode()) + "MH.NDX"
  95.             DGet 0, "HANDLE", STRING007
  96.             DGet 0, "MAIL_NUM", STRING008
  97.             Goto LABEL003
  98.             :LABEL002
  99.             Backup 80
  100.             ClrEol
  101.             Print "@X0CSorry, But that players name was not found, please try again!@X0F"
  102.             Print "                     "
  103.             Wait
  104.             Goto LABEL001
  105.             :LABEL003
  106.             INTEGER004 = 1
  107.             Cls
  108.             PrintLn 
  109.             PrintLn "            @X0BType either @X0A(@X0DQ@X0A)@X0Buit / @X0A(@X0DS@X0A)@X0Bave on a blank line to exit "
  110.             PrintLn "@X01┌────────────────────────────────────────────────────────────────────────────┐@X0F"
  111.             For INTEGER003 = 1 To 10
  112.                 If (INTEGER003 <= 9) Print "@X0E ", INTEGER003, "@X0A)@X0B "
  113.                 If (INTEGER003 == 10) Print "@X0E", INTEGER003, "@X0A)@X0B "
  114.                 InputStr "_", TSTRING003(INTEGER003), 15, 73, Mask_Ascii(), 512 + 8192 + 64
  115.                 If (Upper(TSTRING003(INTEGER003)) == "Q") Goto LABEL001
  116.                 If (Upper(TSTRING003(INTEGER003)) == "S") Break
  117.                 Inc INTEGER004
  118.             Next
  119.             Backup 80
  120.             ClrEol
  121.             PrintLn "@X01└────────────────────────────────────────────────────────────────────────────┘@X0F"
  122.             InputStr "@X0BDo you want to make this Anonymous @X0A(@X0DY@X0A/@X0DN@X0A) _", STRING001, 10, 1, "YynN", 0 + 8
  123.             If (STRING001 == "Y") Then
  124.                 STRING002 = "Anonymous"
  125.             Else
  126.                 STRING002 = STRING005
  127.             Endif
  128.             Backup 80
  129.             ClrEol
  130.             InputStr "@X0BDo you want to Save this message @X0A(@X0DY@X0A/@X0DN@X0A) _", STRING001, 10, 1, "YynN", 0 + 8
  131.             If (STRING001 == "N") Then
  132.                 For INTEGER003 = 1 To 10
  133.                     TSTRING003(INTEGER003) = ""
  134.                 Next
  135.                 Delete PPEPath() + String(PcbNode()) + "-MH.NDX"
  136.                 Goto LABEL001
  137.             Endif
  138.             INTEGER004 = INTEGER004 - 1
  139.             FAppend 1, PPEPath() + String(STRING008) + ".msg", 2, 0
  140.             FPutLn 1, "@X0E" + String(Date()) + " @X0A " + "From @X0E:@X0D " + STRING002
  141.             For INTEGER003 = 1 To INTEGER004
  142.                 FPutLn 1, " @X0B " + TSTRING003(INTEGER003)
  143.             Next
  144.             FPutLn 1, "───────────────────────────────────────────────────────────────────────────"
  145.             FClose 1
  146.             For INTEGER003 = 1 To 10
  147.                 TSTRING003(INTEGER003) = ""
  148.             Next
  149.             Delete PPEPath() + String(PcbNode()) + "-MH.NDX"
  150.             Backup 80
  151.             ClrEol
  152.             PrintLn "@X8CMail Sent!@X0F"
  153.             Print "                     "
  154.             Wait
  155.             Goto LABEL001
  156.         Case "R"
  157.             If (Exist(PPEPath() + String(STRING006) + ".MSG")) Then
  158.                 Cls
  159.                 DispFile PPEPath() + String(STRING006) + ".MSG", 0
  160.                 Print "                     "
  161.                 Wait
  162.                 Goto LABEL001
  163.             Endif
  164.             Backup 80
  165.             ClrEol
  166.             PrintLn "                             @X8C No mail to read!@X0F"
  167.             Newlines 2
  168.             Print "                     "
  169.             Wait
  170.             Goto LABEL001
  171.         Case "G"
  172.             Cls
  173.             DispFile PPEPath() + "Wall.txt", 0
  174.             Print "                     "
  175.             Wait
  176.             Goto LABEL001
  177.         Case "W"
  178.             INTEGER005 = 1
  179.             Cls
  180.             PrintLn 
  181.             INTEGER006 = Random(5)
  182.             If (INTEGER006 == 0) PrintLn "@X0EHelpful Hint:@X0A If you are going to insult someone, check your spelling!@X0F"
  183.             If (INTEGER006 == 1) PrintLn "@X0EHelpful Hint:@X0A To piss someone off, leave Wall messages insulting their mothers!@X0F"
  184.             If (INTEGER006 == 2) PrintLn "@X0EHelpful Hint:@X0A Try gambling to get more money - But watch for the cheat!@X0F"
  185.             If (INTEGER006 == 3) PrintLn "@X0EHelpful Hint:@X0A Use the most graphic language as possible, Much more effective!@X0F"
  186.             If (INTEGER006 == 4) PrintLn "@X0EHelpful Hint:@X0A Form alliances, but never trust anyone!@X0F"
  187.             If (INTEGER006 == 5) PrintLn "@X0EHelpful Hint:@X0A A bribe is always useful to buy someones alliance!@X0F"
  188.             PrintLn 
  189.             PrintLn "            @X0BType either @X0A(@X0DQ@X0A)@X0Buit / @X0A(@X0DS@X0A)@X0Bave on a blank line to exit "
  190.             PrintLn "@X01┌────────────────────────────────────────────────────────────────────────────┐@X0F"
  191.             For INTEGER003 = 1 To 10
  192.                 If (INTEGER003 <= 9) Print "@X0E ", INTEGER003, "@X0A)@X0B "
  193.                 If (INTEGER003 == 10) Print "@X0E", INTEGER003, "@X0A)@X0B "
  194.                 InputStr "_", TSTRING003(INTEGER003), 15, 73, Mask_Ascii(), 512 + 8192 + 64
  195.                 If (Upper(TSTRING003(INTEGER003)) == "Q") Goto LABEL001
  196.                 If (Upper(TSTRING003(INTEGER003)) == "S") Break
  197.                 Inc INTEGER005
  198.             Next
  199.             Backup 80
  200.             ClrEol
  201.             PrintLn "@X01└────────────────────────────────────────────────────────────────────────────┘@X0F"
  202.             InputStr "@X0BDo you want to make this Anonymous @X0A(@X0DY@X0A/@X0DN@X0A) _", STRING001, 10, 1, "YynN", 0 + 8
  203.             If (STRING001 == "Y") Then
  204.                 STRING002 = "Anonymous"
  205.             Else
  206.                 STRING002 = STRING005
  207.             Endif
  208.             Backup 80
  209.             ClrEol
  210.             InputStr "@X0BDo you want to Save this wall message @X0A(@X0DY@X0A/@X0DN@X0A) _", STRING001, 10, 1, "YynN", 0 + 8
  211.             If (STRING001 == "N") Then
  212.                 For INTEGER003 = 1 To 10
  213.                     TSTRING003(INTEGER003) = ""
  214.                 Next
  215.                 Delete PPEPath() + String(PcbNode()) + "-MH.NDX"
  216.                 Goto LABEL001
  217.             Endif
  218.             INTEGER005 = INTEGER005 - 1
  219.             FAppend 1, PPEPath() + "Wall.Txt", 2, 0
  220.             FPutLn 1, "@X0E" + String(Date()) + " @X0A " + "From @X0E:@X0D " + STRING002
  221.             For INTEGER003 = 1 To INTEGER005
  222.                 FPutLn 1, " @X0B " + TSTRING003(INTEGER003)
  223.             Next
  224.             FPutLn 1, "───────────────────────────────────────────────────────────────────────────"
  225.             FClose 1
  226.             For INTEGER003 = 1 To 10
  227.                 TSTRING003(INTEGER003) = ""
  228.             Next
  229.             Backup 80
  230.             ClrEol
  231.             PrintLn "@X8CMail Sent!@X0F"
  232.             Print "                     "
  233.             Wait
  234.             Goto LABEL001
  235.         Case "M"
  236.             DCloseAll
  237.             Delete PPEPath() + String(PcbNode()) + "-MH.NDX"
  238.             End
  239.     End Select
  240.  
  241. ;------------------------------------------------------------------------------
  242. ;
  243. ; Usage report (before postprocessing)
  244. ;
  245. ; ■ Statements used :
  246. ;
  247. ;    1       End
  248. ;    5       Cls
  249. ;    11      ClrEol
  250. ;    8       Wait
  251. ;    54      Goto 
  252. ;    35      Let 
  253. ;    14      Print 
  254. ;    28      PrintLn 
  255. ;    38      If 
  256. ;    2       DispFile 
  257. ;    2       FAppend 
  258. ;    2       FClose 
  259. ;    6       FPutLn 
  260. ;    6       Delete 
  261. ;    8       InputStr 
  262. ;    2       Inc 
  263. ;    1       Newline
  264. ;    2       Newlines 
  265. ;    11      Backup 
  266. ;    1       DOpen 
  267. ;    3       DCloseAll
  268. ;    1       DnCreate 
  269. ;    1       DnCloseAll 
  270. ;    1       DTop 
  271. ;    1       DGo 
  272. ;    1       DSeek 
  273. ;    4       DGet 
  274. ;
  275. ;
  276. ; ■ Functions used :
  277. ;
  278. ;    54      +
  279. ;    2       -
  280. ;    25      ==
  281. ;    8       <
  282. ;    10      <=
  283. ;    1       >
  284. ;    16      >=
  285. ;    21      !
  286. ;    16      &&
  287. ;    8       ||
  288. ;    6       Upper()
  289. ;    4       Trim()
  290. ;    1       Random()
  291. ;    2       Date()
  292. ;    14      String()
  293. ;    3       Mask_Ascii()
  294. ;    14      PPEPath()
  295. ;    8       PcbNode()
  296. ;    1       GetEnv()
  297. ;    2       Exist()
  298. ;    1       ToInteger()
  299. ;    2       Mixed()
  300. ;    2       DRecNo()
  301. ;    1       DChkStat()
  302. ;
  303. ;------------------------------------------------------------------------------
  304. ;
  305. ; Analysis flags : No flag
  306. ;
  307. ;------------------------------------------------------------------------------
  308. ;
  309. ; Postprocessing report
  310. ;
  311. ;    8       For/Next
  312. ;    0       While/EndWhile
  313. ;    7       If/Then or If/Then/Else
  314. ;    1       Select Case
  315. ;
  316. ;------------------------------------------------------------------------------
  317. ;                 AEGiS Corp - Break the routines, code against the machines!
  318. ;------------------------------------------------------------------------------
  319.